home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happysrc / pcdcl.c < prev    next >
Text File  |  1993-11-30  |  30KB  |  747 lines
  1. /**********************************************************************
  2.  *
  3.  *    ***  HAPPy Pascal Compiler ***
  4.  *
  5.  *             宣言部のコンパイル
  6.  *
  7.  *    ラベル宣言部        void labeldecl(Set fsys)
  8.  *    定数定義部          void constdecl(Set fsys)
  9.  *    型定義部            void typedecl(Set fsys)
  10.  *    変数宣言部          void vardecl(Set fsys,ctp *fprocp)
  11.  *    手続き/関数宣言部   void procfuncdecl
  12.  *                            (Set fsys,enum symbol fsy,ctp **pffwdptr)
  13.  *
  14.  *           Copyrignt (c) H.Asano 1992
  15.  *
  16.  **********************************************************************/
  17.  
  18. #define EXTERN extern
  19.  
  20. #include <string.h>
  21. #include "pascomp.h"
  22.  
  23. extern void block(Set,enum symbol,ctp*);
  24. extern int crelabel(void) ;
  25. extern void pcerr(int,char*) ;
  26. extern char *inttoch(long)   ;
  27. extern char *inttoch(long)   ;
  28. extern Set  *mkset(Set*,int,...) ;
  29. extern Set  *orset(Set*,Set*) ;
  30. extern void insymbol(void) ;
  31. extern void skip(Set) ;
  32. extern void updatelc(int) ;
  33. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  34. extern void enterid(ctp*) ;
  35. extern ctp *searchid(Set) ;
  36. extern ctp *searchsection(ctp*)  ;
  37. extern boolean typ(Set, stp**,int*) ;
  38. extern void constant(Set,stp**,union valu*)  ;
  39. extern int  align(stp*,int) ;
  40. extern void applied(ctp*,int)   ;
  41. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  42. extern void *Malloc(int) ;
  43. extern void *mark(void)  ;
  44. extern void release(void*) ;
  45. extern void putfilename(char*,int,int);
  46.  
  47. /*********************************************/
  48. /*     labeldecl() : label宣言部コンパイル   */
  49. /*********************************************/
  50. void labeldecl(Set fsys)
  51. {
  52.   lbp     *llp  ;
  53.   boolean redef ;                       /* redefine flag              */
  54.   boolean test  ;                       /* 繰り返しのために使う       */
  55.   Set     ws    ;                       /* 作業用集合                 */
  56.  
  57.      do {
  58.       if(sy == intconst) {              /* 整数の時                   */ 
  59.        redef = false ; 
  60.        llp = display[top].flabel ;
  61.        while(llp) {                     /* label テーブル サーチ      */
  62.         if(llp->labval != (int)val.ival) llp = llp->nextlab ;
  63.         else {                          /*  同じ値があった            */
  64.          redef = true ;
  65.          pcerr(166,inttoch(val.ival)) ; /*  ラベルが再度宣言された    */
  66.          break ;
  67.         }
  68.        }
  69.        if(! redef) {                       /* 再宣言でないとき (OKの時)*/
  70.         llp = (lbp*)Malloc(sizeof(lbp)) ;  /* label テーブル 確保     */
  71.         llp->labval  = (int)val.ival ;     /* ラベル値                */
  72.         llp->labname = crelabel() ;        /* P-codeのラベル名生成    */
  73.         llp->defined = false    ;          /* 定義未とする            */
  74.         llp->nextlab = display[top].flabel ;
  75.         display[top].flabel = llp ;        /* ﾎﾟｲﾝﾀのつなぎかえ       */
  76.  
  77.         if((val.ival < 0) || (val.ival > 9999)) /* 0～9999の間でない時*/
  78.          pcerr(164,"") ;                   /* ラベルが誤っている      */
  79.        }
  80.        insymbol() ;
  81.       }
  82.       else pcerr(164,"") ;              /* 整数でない時 ラベル誤り    */
  83.  
  84.       mkset(&ws, comma,semicolon, -1) ;
  85.       orset(&ws, &fsys) ;
  86.       if( ! inset(ws,sy)) {      /* 次のsymbolの正当性チェック       */
  87.        pcerr(6,"")      ;        /*   不当な記号が現れた             */
  88.        skip(ws)         ;        /*   正しいところまで読み飛ばし     */
  89.       }
  90.  
  91.       test = (sy == comma) ;
  92.       if(test) insymbol()  ;     /*  , ならば次のsymbolを読む        */
  93.      } while(test)         ;     /*  , であれば繰り返す              */
  94.  
  95.      if(sy == semicolon) insymbol() ;    /* ; だったら次のsymbol     */
  96.      else                pcerr(14,"");   /* ; がない　               */
  97. }
  98.  
  99. /*********************************************/
  100. /*     constdecl() : 定数定義部のコンパイル  */
  101. /*********************************************/
  102. void constdecl(Set fsys)
  103. {
  104.   ctp   *lcp ;
  105.   stp   *lsp ;
  106.   union valu  lvalu ;
  107.   Set   ws1   ;
  108.   Set   ws2   ;
  109.  
  110.      ws1 = fsys             ;
  111.      addset(ws1, ident)     ;           /* ws1 = fsys + [ident]       */
  112.      ws2 = fsys             ;
  113.      addset(ws2, semicolon) ;           /* ws2 = fsys + [semicolon]   */
  114.  
  115.      if(sy != ident) {
  116.       pcerr(2,id)    ;                  /* 名前がない                 */
  117.       skip(ws1)            ;            /* fsys+[ident]まで読み飛ばし */
  118.      }
  119.  
  120.      while(sy == ident) {
  121.       lcp = mkctp(id,konst,nil,nil) ; 
  122.       insymbol() ;
  123.       if(op == eqop) insymbol() ;       /* = なら 次のsymbolを読む    */
  124.       else           pcerr(16,"") ;     /* = がない                   */
  125.       constant(ws2, &lsp, &lvalu) ;     /* 右辺の処理                 */
  126.       lcp->idtype = lsp           ;     /* 右辺の型 (lsp)             */
  127.       lcp->n.values = lvalu       ;     /* 右辺の値 (lavlu)           */
  128.       enterid(lcp)                ;     /* 左辺の名前を登録           */
  129.  
  130.       if(sy == semicolon) {             /* ; ならば                   */ 
  131.        insymbol()  ;                    /*  次のsymbolを読む          */
  132.        if( ! inset(ws1,sy)) {           /*    fsysまたは名前でない　  */
  133.         pcerr(6,"")   ;                 /*    不当な記号が現れた      */
  134.         skip(ws1)  ;                    /* fsys+identのsymbolまでskip */
  135.        }
  136.       } else pcerr(14,"")  ;            /* ; がない　                 */
  137.      }
  138. }
  139.  
  140. /*********************************************/
  141. /*      typedecl() : 型定義部のコンパイル    */
  142. /*********************************************/
  143. void typedecl(Set fsys)
  144. {
  145.   ctp *lcp ;
  146.   ctp *lcp1 ;                           /* 前方参照解決用             */
  147.   ctp *lcp2 ;                           /* lcp1の1つ前の値            */
  148.   stp *lsp ;
  149.   int lsize ;
  150.   Set ws ;
  151.  
  152.      typevar = true ;                   /* 型定義部での型の処理       */
  153.      
  154.      if(sy != ident) {                  /* 名前でない                 */
  155.       pcerr(2,"") ;                     /*  名前がない                */
  156.       mkset(&ws, ident, -1) ;
  157.       orset(&ws, &fsys)     ;
  158.       skip(ws)              ;           /* fsys+[ident] まで読み飛ばし*/
  159.      }
  160.  
  161.      while(sy == ident) {               /*                            */
  162.       lcp = mkctp(id,types,nil,nil) ;   /*  名前のエリアを確保        */
  163.       insymbol()            ;
  164.       if(op == eqop) insymbol() ;       /* = ならば次のsymbol         */
  165.       else pcerr(16,"")     ;           /*  =がない                   */
  166.  
  167.       mkset(&ws, semicolon,-1) ;
  168.       orset(&ws,&fsys) ;
  169.       typ(ws, &lsp, &lsize) ;
  170.       if(lsp && !lsp->assignflag && lsp->form != files) 
  171.                                         /* ファイル型を含む型の時     */
  172.        pcerr(608,"") ;                  /* 局所ファイルは駄目         */
  173.       lcp->idtype = lsp     ;
  174.       enterid(lcp)          ;
  175.  
  176.    /*** 前方参照リストのうち今定義された型を参照しているものを解決 ***/
  177.       lcp1 = fwptr ;
  178.       while(lcp1) {
  179.        if(strcmp(lcp1->name, lcp->name) == 0) {     /* 型名が等しい     */
  180.         lcp1->idtype->sf.pt.eltype = lcp->idtype ;  /* 型を入れる       */
  181.         if(lcp1 != fwptr) lcp2->next = lcp1->next ; /*  チェーンから外す*/
  182.         else fwptr = lcp1->next ;       /* fwptr先頭の時は次を新fwptrに */
  183.        }
  184.        else lcp2 = lcp1 ;               /* 次のループのために退避     */
  185.        lcp1 = lcp1->next ;
  186.       }
  187.  
  188.       if(sy == semicolon) {
  189.        insymbol() ;
  190.        mkset(&ws,ident,-1) ;
  191.        orset(&ws,&fsys) ;
  192.        if(! inset(ws,sy)) {
  193.         pcerr(6,"") ;                   /* 不当な記号が現れた         */
  194.         skip(ws)    ;                   /* fsys+[ident]まで読み飛ばし */
  195.        }
  196.       } else pcerr(14,"") ;             /* ; がない                   */
  197.      }
  198.  
  199.      while(fwptr) {                     /* 前方参照が未解決の時       */
  200.       pcerr(117,fwptr->name) ;          /*   前方参照未解決           */
  201.        fwptr = fwptr->next   ;
  202.      } ;
  203. }
  204.  
  205. /*********************************************/
  206. /*      vardecl() : var節のコンパイル        */
  207. /*********************************************/
  208. void vardecl(Set fsys,ctp *fprocp)
  209. {
  210.   static fileno = 0 ;
  211.   ctp *lcp ;
  212.   ctp *nxt ;
  213.   stp *lsp ;
  214.   extfilep *extp ;
  215.   int lsize ;
  216.   boolean test;
  217.   boolean notfound ;
  218.   Set  ws ;
  219.  
  220.      nxt = nil ;
  221.      typevar = false ;                  /* 変数定義部での型の処理     */
  222.  
  223.      do {
  224.       do {
  225.        if(sy == ident) {
  226.         lcp = mkctp(id,vars,nil,nxt) ;  /* 名前を変数として登録       */
  227.         lcp->n.v.vkind = actual ;
  228.         lcp->n.v.vlev  = level  ;
  229.         enterid(lcp) ;
  230.         nxt = lcp ;
  231.  
  232.         insymbol() ;
  233.        }
  234.        else pcerr(2,id) ;               /* 名前がない                 */
  235.  
  236.        mkset(&ws, comma, colon, -1) ;   /* ws = [comma,colon]         */
  237.        orset(&ws, &fsys)            ;   /*     + fsys                 */
  238.        orset(&ws, &typedels)        ;   /*     + typedels             */
  239.        if(! inset(ws,sy)) {
  240.         pcerr(6,"")             ;       /*  不当な記号が現れた        */
  241.         addset(ws,semicolon)    ;
  242.         skip(ws)                ;       /*  誤り回復のため読み飛ばし  */
  243.        }
  244.  
  245.        if(test = (sy == comma)) insymbol() ;  /* , なら次のsymbol     */
  246.       } while(test) ;                   /*       , なら繰り返す       */
  247.  
  248.       if(sy == colon) insymbol() ;      /* : なら次のsymbol           */
  249.       else pcerr(5,"")           ;      /* : がない                   */
  250.  
  251.       ws = fsys ;
  252.       orset(&ws,&typedels) ;
  253.       addset(ws,semicolon) ;
  254.       typ(ws, &lsp, &lsize)   ;
  255.       if(lsp && !lsp->assignflag && lsp->form != files) 
  256.                                         /* ファイル型を含む型の時     */
  257.        pcerr(608,"") ;                  /* 局所ファイルは駄目         */
  258.  
  259.       while(nxt) {
  260.        updatelc(align(lsp,lc) - lc);    /* 変数の割りつけ開始番地     */
  261.        nxt->idtype = lsp      ;         /* 変数の型                   */
  262.        nxt->n.v.vaddr = lc    ;         /* 変数の割りつけ番地         */
  263.        if(lsp && lsp->form == files)    /*  ファイル変数の時          */
  264.         if(!fprocp && fextfilep) {      /*    メインブロックで
  265.                                             プログラム引数がある時    */
  266.          extp = fextfilep ;
  267.          notfound = true  ;
  268.          while(extp && notfound) {      /* プログラム引数と照合       */
  269.           if(!strcmp(extp->filename,nxt->name)) { /* 引数に書いた名前 */
  270.            if(++fileno > Maxfileno)     /* 最大ファイル数を越えている */
  271.             pcerr(600,inttoch((long)Maxfileno)) ;
  272.            putfilename(nxt->name,lc,nxt->idtype->size) ;
  273.                                         /*  ファイル情報を出力する    */
  274.            notfound = false ;
  275.           }
  276.           extp = extp->nextfile  ;
  277.          }
  278.          if(notfound) pcerr(608,"") ;   /* 局所ファイルは駄目         */
  279.         }
  280.         else pcerr(608,"") ;            /* メインブロック以外または
  281.                                            プログラム引数がない時     */ 
  282.        updatelc(lsize)  ;               /* lc 更新                    */
  283.        nxt = nxt->next  ;
  284.       }
  285.  
  286.       if(sy == semicolon) {
  287.        insymbol() ;
  288.        ws = fsys  ;
  289.        addset(ws,ident) ;
  290.        if(! inset(ws,sy)) {
  291.         pcerr(6,"") ;                   /* 不当な記号が現れた         */
  292.         skip(ws)    ;                   /* fsys+[ident]まで読み飛ばし */
  293.        }
  294.       }
  295.       else pcerr(14,"") ;               /* ; がない                   */
  296.      
  297.      } while((sy == ident) || (inset(typedels,sy))) ;
  298. }
  299.  
  300. /*************************************************/
  301. /*  procfuncdecl() : procedure/function宣言部の  */
  302. /*                             コンパイル        */
  303. /*************************************************/
  304.  
  305. typedef enum prmkind { normal,          /* ブロックと結合された引数   */
  306.                        procfunc }       /* 関数､手続き引数の引数      */
  307.              prmkind ;
  308.              
  309. static void pfparmlist(ctp**,Set,Set,boolean,prmkind) ;
  310. static void functype(Set,ctp*,boolean) ;
  311. static ctp  *pfident(Set,enum symbol,boolean*,boolean*)   ;
  312. static void prmpflist(Set,ctp**,prmkind) ;
  313. static void prmvarlist(Set,Set,ctp**,prmkind)  ;
  314.                        
  315. void procfuncdecl(Set fsys,enum symbol fsy,ctp **pffwdptr)
  316. {
  317.  
  318.   int oldlc ;                           /* location counter 退避域    */
  319.   int oldlevel ;                        /* level退避域                */
  320.   int oldtop   ;                        /* top退避域                  */
  321.   ctp *lcp     ;                        /* proc/funcの名前ポインタ    */
  322.   ctp *lcp1,*lcp2  ;                    /* 前方宣言解決用のポインタ   */
  323.   void *markadr ;                       /* 一括解放アドレス           */
  324.   boolean forw ;                        /* すでに宣言されている時true */
  325.   boolean err160 ;
  326.   Set ws       ;
  327.  
  328.      oldlc = lc   ;                     /* 今のlocation counterを退避 */
  329.      lc  = lcaftermarkstack ;           /* 新しくlcを初期設定         */
  330.      
  331.      lcp = pfident(fsys,fsy,&forw,&err160) ; /* 名前の処理            */
  332.      
  333.      oldlevel = level ;                 /* 今の水準を退避             */
  334.      oldtop   = top   ;                 /* 今のdisplay先頭位置を退避  */
  335.  
  336.      if(level < Maxlevel) level++ ;     /* 水準オーバでなければ水準を増やす*/
  337.      else pcerr(604,inttoch((long)Maxlevel)) ;
  338.                                         /* 手続き･関数の入れ子が深すぎ*/
  339.      if(top   < Displimit) {            /* displayがまだある時        */
  340.       top++ ;                           /* 新しい水準のdisplay初期設定*/
  341.       display[top].fname  = (forw) ? lcp->next : nil ;
  342.       display[top].flabel = nil  ;
  343.       display[top].aname  = nil  ;
  344.       display[top].occur  = blck ;
  345.       display[top].funcname = (fsy==funcsy) ? lcp : nil ; /* 関数名   */
  346.       display[top].funcassign = false ; /* 関数への代入未(手続き無効) */
  347.      }
  348.      else pcerr(603,inttoch((long)Displimit)) ;
  349.                                         /* 名前の入れ子が深すぎる     */
  350.  
  351.      if(fsy == procsy) {                /* 手続きの時                 */
  352.       mkset(&ws,semicolon,-1) ;
  353.       pfparmlist(&(lcp->next),ws,fsys,forw,normal) ;
  354.      }
  355.      else {
  356.       mkset(&ws,semicolon,colon,-1);
  357.       pfparmlist(&(lcp->next),ws,fsys,forw,normal) ;
  358.       functype(fsys,lcp,forw);          /* 関数の型の処理             */
  359.      }
  360.  
  361.      if(sy == semicolon) insymbol() ;
  362.      else pcerr(14,"") ;                /* ; がない                   */
  363.  
  364.      if((sy==ident) && (strcmp(id,"forward")==0)) {
  365.                                         /* forward指令があった時      */
  366.       if(forw)
  367.        pcerr(161,lcp->name) ;           /* 再び前方宣言された         */
  368.       else if(!err160 && ((lcp->klass==proc) || (lcp->klass==func))) {
  369.        lcp->n.pf.sd.d.af.a.fwdptr=*pffwdptr; /* 前方宣言名をつなぐ    */
  370.        *pffwdptr = lcp ;
  371.        lcp->n.pf.sd.d.af.a.forwdecl = true ;
  372.       } 
  373.       insymbol() ;
  374.       if(sy == semicolon) insymbol() ;
  375.       else pcerr(14,"") ;               /* ; がない                   */
  376.       if(! inset(fsys,sy)) {            /* 終端記号にない時           */
  377.        pcerr(6,"") ;                    /*   不当な記号が現れた       */
  378.        skip(fsys)  ;                    /*   読み飛ばし               */
  379.       }
  380.      }
  381.      else {                             /* forward指令がない時        */
  382.       lcp->n.pf.sd.d.af.a.forwdecl = false ;
  383.       lcp1 = *pffwdptr ;                /* 前方宣言リストから外す     */
  384.       while(lcp1) {
  385.        if(strcmp(lcp1->name,lcp->name) == 0) {
  386.         if(lcp1 != *pffwdptr)
  387.          lcp2->n.pf.sd.d.af.a.fwdptr = lcp1->n.pf.sd.d.af.a.fwdptr ;
  388.         else *pffwdptr = lcp1->n.pf.sd.d.af.a.fwdptr ;
  389.        }
  390.        else lcp2 = lcp1 ;
  391.        lcp1 = lcp1->n.pf.sd.d.af.a.fwdptr ;
  392.       }
  393.       markadr = mark() ;                /* 一括解放アドレスをマーク   */
  394.       do {
  395.        block(fsys,semicolon,lcp) ;      /* ブロック処理               */
  396.        if(sy == semicolon) {
  397.         insymbol() ;
  398.         mkset(&ws,beginsy,procsy,funcsy,-1);
  399.         if(! inset(ws,sy)) {
  400.          pcerr(6,"") ;                  /* 不当な記号が現れた         */
  401.          skip(ws)    ;                  /* 読み飛ばし                 */
  402.         }
  403.        }
  404.        else pcerr(14,"") ;              /* ; がない                   */
  405.       } while(! inset(ws,sy)) ;         /* begin,procedure,functionなら抜ける*/
  406.       release(markadr) ;                /* heapメモリを一括解放       */
  407.      }
  408.  
  409.      level = oldlevel ;                 /* 前の水準に復帰             */
  410.      top   = oldtop   ;                 /* 前のdisplay先頭に復帰      */
  411.      lc    = oldlc    ;                 /* 前のlocation counterに復帰 */
  412. }
  413.  
  414. /***************************************/
  415. /* pfident() : proc/funcの名前の処理   */
  416. /***************************************/
  417. static ctp *pfident(Set fsys,enum symbol fsy,boolean *ffwd,boolean *err160)
  418. {
  419.   ctp *lcp,*lcp1 ;
  420.   boolean forw = false ;                /* 前方参照宣言フラグ         */
  421.  
  422.      *err160 = false ;
  423.      
  424.      if(sy != ident) {                  /* 名前でない                 */
  425.       pcerr(2,"") ;                     /*   名前がない               */
  426.       insymbol()  ;
  427.       return(ufctptr) ;                 /*  未定義用の名前エリアを返却*/
  428.      }
  429.  
  430.      lcp = searchsection(display[top].fname) ; /* 同じ水準から名前を探す*/
  431.      if(lcp)                            /* 名前が見つかった           */
  432.       if((lcp->klass == proc) || (lcp->klass == func)) { /*forward宣言*/
  433.        forw = (((lcp->klass==proc) && (fsy==procsy)) ||  /*されている */
  434.                ((lcp->klass==func) && (fsy==funcsy)))    /*かチェック */
  435.            && (lcp->n.pf.sd.d.pfkind==actual)
  436.            && (lcp->n.pf.sd.d.af.a.forwdecl)  ;
  437.        if(! forw) {
  438.         pcerr(160,id) ;                 /* 既に正式な宣言が行われている*/
  439.         *err160 = true ;                /* かなりヤクザなやり方です    */
  440.         forw    = true ;
  441.        }
  442.       }
  443.       else pcerr(101,lcp->name);        /* 名前の二重定義エラー       */
  444.      else {                             /* 名前が見つからなかった     */
  445.       lcp = (fsy == procsy) ? mkctp(id,proc,nil,nil)  /* 名前エリア確保*/
  446.                             : mkctp(id,func,nil,nil) ;
  447.       lcp->n.pf.pfdeckind     = declared  ;
  448.       lcp->n.pf.sd.d.pfkind   = actual    ;
  449.       lcp->n.pf.sd.d.pflev    = level     ;
  450.       lcp->n.pf.sd.d.af.a.pfname   = crelabel();
  451.       enterid(lcp) ;                    /* 名前の登録                 */
  452.      }
  453.      if(forw) {                         /* 前方宣言された名前の時     */
  454.       lcp1 = lcp->next ;                /*    変数の割当をする        */
  455.       while(lcp1 && lcp1->next)         /* 最後の引数を得る           */
  456.        lcp1 = lcp1->next ;
  457.       switch(lcp1->klass) {
  458.        case vars :                     /* 変数                        */
  459.               updatelc(lcp1->n.v.vaddr - lc) ;
  460.               if(lcp1->n.v.vkind==actual){ /* 値引数                  */
  461.                if(lcp1->idtype)        /*   型がエラーでない時        */
  462.                 updatelc(lcp1->idtype->size); /* サイズ分進める       */
  463.               }
  464.               else                     /*   変数引数                  */
  465.                updatelc(ptrsize);      /*     ポインタサイズだけ進める*/
  466.              break ;
  467.        case proc :
  468.        case func :                      /* 手続き 関数                */
  469.              updatelc((lcp1->n.pf.sd.d.af.f.adradr + ptrsize) - lc) ;
  470.              break ;
  471.       }
  472.      }
  473.  
  474.      insymbol()   ;
  475.      *ffwd = forw ;
  476.      return(lcp)  ;
  477. }
  478.  
  479. /****************************************/
  480. /*  functype() : 関数の型処理           */
  481. /****************************************/
  482. static void functype(Set fsys,ctp *fcp,boolean forw)
  483. {
  484.   ctp *lcp1;
  485.   stp *lsp ;
  486.   Set ws ;
  487.  
  488.      if(sy == colon) {                  /* : の 時                    */
  489.       insymbol() ;                      /*  型を読む                  */
  490.       if(sy == ident) {
  491.        if(forw) pcerr(122,fcp->name) ;  /* 再び型を書いてはいけない   */
  492.        mkset(&ws,types,-1) ;
  493.        lcp1 = searchid(ws) ;            /* 型名より探す               */
  494.        fcp->idtype = lsp = lcp1->idtype  ;
  495.        if(lsp) {
  496.         mkset(&ws,scalar,subrange,pointer,-1);
  497.         if(! inset(ws,lsp->form)) {     /* 型がスカラ､範囲型､ポインタでない時*/
  498.          pcerr(120,fcp->name) ;         /* 関数の型の誤り             */
  499.          fcp->idtype = nil ;
  500.         }
  501.        } 
  502.        insymbol() ;
  503.       }
  504.       else {
  505.        pcerr(2,"") ;                    /* 名前がない                 */
  506.        ws = fsys ;
  507.        addset(ws,semicolon) ;
  508.        skip(ws)  ;                      /* 読み飛ばし                 */
  509.       }
  510.      }
  511.      else                               /* : がない時                  */
  512.       if(! forw) pcerr(123,fcp->name);  /* 関数の宣言に型がない        */
  513. }
  514.  
  515. /*****************************************/
  516. /* pfparamlist() : パラメータリスト処理  */
  517. /*****************************************/
  518. static void pfparmlist(ctp **fcp,Set fsys,Set fpfsys,boolean forw,prmkind kind)
  519. {
  520.   ctp *lcp1,*lcp2,*lcp3 ;
  521.   Set ws,ws1     ;
  522.   Set prmbegsys  ;                      /* 引数の最初のsymbolとしてOKのもの*/
  523.  
  524.      mkset(&prmbegsys, ident,varsy,procsy,funcsy, -1);
  525.      lcp1 = nil ;
  526.  
  527.      ws = fsys ;
  528.      addset(ws,lparent) ;
  529.      if(! inset(ws,sy)) { 
  530.       pcerr(7,"") ;                     /* 引数の並びに誤りがある     */
  531.       orset(&ws,&fpfsys) ;
  532.       skip(ws)    ;                     /* 読み飛ばし                 */
  533.      }
  534.  
  535.      if(sy == lparent) {
  536.       if(forw) pcerr(119,"") ;          /* 前方宣言されているので引数は駄目*/
  537.       insymbol() ;
  538.       if(! inset(prmbegsys,sy)) {
  539.        pcerr(7,"") ;                    /* 引数の並びに誤りがある     */
  540.        mkset(&ws,ident,rparent,-1) ;
  541.        orset(&ws,&fpfsys) ;
  542.        skip(ws)    ;                    /* 読み飛ばし                 */
  543.       }
  544.  
  545.       ws = prmbegsys ;
  546.       orset(&ws,&fpfsys) ;
  547.       while(inset(prmbegsys,sy)) {      /* 引数の開始symbolとしてokの間*/
  548.        switch(sy) {
  549.         case procsy :
  550.         case funcsy : prmpflist(fpfsys,&lcp1,kind) ;   /* 手続き､関数引数*/
  551.                       break ;      
  552.         default     : prmvarlist(fsys,fpfsys,&lcp1,kind) ; /* 変数,値引数*/
  553.        }
  554.        if(sy == semicolon) {
  555.         insymbol() ;
  556.         if(! inset(ws,sy)) {
  557.          pcerr(7,"") ;                  /* 引数の並びに誤りがある     */
  558.          mkset(&ws1,ident,rparent,-1);
  559.          skip(ws1) ;                    /* 読み飛ばし                 */
  560.         } 
  561.        }
  562.       }
  563.  
  564.       if(sy == rparent) insymbol() ;
  565.       else              pcerr(4,"") ;   /* ) がない                   */
  566.      }
  567.  
  568.      /* reverse pointers and reserve local cells for copies of
  569.         multiple values  */
  570.  
  571.      lcp3 = nil ;
  572.      while(lcp1) {                      /* 最初のlcp1は最後のﾊﾟﾗﾒｰﾀを指す*/
  573.       lcp2 = lcp1->next ;
  574.       lcp1->next = lcp3 ;
  575.       if(kind == normal)                /* ブロックと結合される引数   */ 
  576.        if(lcp1->klass == vars)          /*  変数の時                  */
  577.         if(lcp1->idtype)
  578.          if((lcp1->n.v.vkind==actual) &&     /* 局所変数(値渡し)で    */
  579.             (lcp1->idtype->form > power)) {  /* 配列･レコードの時     */
  580.           updatelc(align(lcp1->idtype,lc) - lc) ;
  581.           lcp1->n.v.vaddr = lc ;        /* 変数アドレス割りつけ       */  
  582.           updatelc(lcp1->idtype->size);
  583.          }
  584.       lcp3 = lcp1 ;
  585.       lcp1 = lcp2 ;
  586.      }
  587.  
  588.      if(((kind==normal) && (!forw)) || (kind==procfunc) )
  589.       *fcp = lcp3 ;                     /* 引数の並びを設定           */
  590. }
  591.  
  592. /*******************************************/
  593. /* prmpflist() : 手続き･関数パラメータ処理 */
  594. /*******************************************/
  595. static void prmpflist(Set fsys,ctp **fcp1,prmkind kind)
  596. {
  597.   ctp *lcp;
  598.   enum symbol lsy ;
  599.   int oldtop ;
  600.   Set ws  ;
  601.   
  602.   /****** 手続き名･関数名の処理 *****/
  603.    
  604.      lsy = sy   ;
  605.      insymbol() ;
  606.      if(sy != ident) {                  /* 名前でない                 */
  607.       pcerr(2,"") ;                     /*   名前がない               */
  608.       insymbol()  ;
  609.       lcp = ufctptr ;                   /* 名前がない時の仮のエリア   */
  610.      }
  611.      else {
  612.       lcp = (lsy == procsy) ? mkctp(id,proc,nil,*fcp1)/* 名前エリア確保*/
  613.                             : mkctp(id,func,nil,*fcp1) ;
  614.       lcp->n.pf.pfdeckind     = declared  ;
  615.       lcp->n.pf.sd.d.pfkind   = formal    ;       /* 仮手続き･仮関数  */
  616.       lcp->n.pf.sd.d.pflev    = level     ;       /* 定義水準         */
  617.       enterid(lcp) ;                    /* 名前の登録                 */
  618.      }
  619.      *fcp1 = lcp ;
  620.      
  621.   /***** 仮パラメータ並びの処理 *****/
  622.   
  623.      oldtop = top ;
  624.      if(top   < Displimit) {            /* displayがまだある時        */
  625.       top++ ;                           /* 新しい水準のdisplay初期設定*/
  626.       display[top].fname  = nil  ;
  627.       display[top].aname  = nil  ;
  628.       display[top].flabel = nil  ;      /* 意味なし                   */
  629.       display[top].occur  = blck ;      /* 意味なし                   */ 
  630.      }
  631.      else pcerr(603,inttoch((long)Displimit)) ;
  632.                                         /* 名前の入れ子が深すぎる     */
  633.  
  634.      insymbol() ;  
  635.      if(lsy == procsy) {                /* 手続きの時                 */
  636.       mkset(&ws,rparent,semicolon,-1) ;
  637.       pfparmlist(&(lcp->n.pf.sd.d.af.f.prm),ws,fsys,false,procfunc) ;
  638.      }
  639.      else {
  640.       mkset(&ws,rparent,semicolon,colon,-1);
  641.       pfparmlist(&(lcp->n.pf.sd.d.af.f.prm),ws,fsys,false,procfunc) ;
  642.       functype(fsys,lcp,false);         /* 関数の型の処理             */
  643.      }
  644.  
  645.      if(kind == normal) {               /* ブロックと結合される時     */
  646.       updatelc(align(intptr,lc) - lc) ;
  647.       lcp->n.pf.sd.d.af.f.levadr = lc ; /* 水準差をのせるアドレス     */
  648.       updatelc(intsize) ;
  649.       updatelc(align(nilptr,lc) - lc) ; 
  650.       lcp->n.pf.sd.d.af.f.adradr = lc ; /*実行アドレスをのせるアドレス*/
  651.       updatelc(ptrsize) ;                                  
  652.      }
  653.  
  654.      top = oldtop ;
  655. }
  656.  
  657. /*****************************************/
  658. /* prmvarlist() : 変数､値パラメータ処理  */
  659. /*****************************************/
  660. static void prmvarlist(Set fsys,Set fpfsys,ctp **fcp1,prmkind kind)
  661. {
  662.   enum idkind lkind ;                   /* actual ･･･ 値パラメータ
  663.                                            formal ･･･ 変数パラメータ  */
  664.   ctp *lcp,*lcp2,*lcp3 ;
  665.   stp *lsp             ;
  666.   int count  = 0       ;
  667.   int number = 0       ;
  668.   int lsize            ;
  669.   int llc              ;
  670.   boolean test         ;
  671.   Set ws               ;
  672.  
  673.      if(sy == varsy) {
  674.       lkind = formal ;                  /* varの付くものは変数引数    */
  675.       insymbol()     ;
  676.      }
  677.      else lkind = actual ;              /* varが付かなければ値引数    */
  678.  
  679.      lcp2 = nil ;
  680.      do {
  681.       if(sy == ident) {
  682.        lcp = mkctp(id,vars,nil,lcp2) ;  /* 変数用のエリアを確保       */
  683.        lcp->n.v.vkind = lkind ;
  684.        lcp->n.v.vlev  = level ;
  685.        enterid(lcp) ;
  686.        lcp2 = lcp ;
  687.        count++    ;
  688.        insymbol() ;
  689.       }
  690.       mkset(&ws,comma,colon,-1);
  691.       orset(&ws,&fpfsys) ;
  692.       if(! inset(ws,sy)) {
  693.        pcerr(7,"") ;                    /* 引数の並びに誤りがある     */
  694.        addset(ws,rparent);
  695.        skip(ws)    ;                    /* 読み飛ばし                 */
  696.       }
  697.       if(test=(sy==comma)) insymbol() ; /* , ならば次のsymbolを読む   */
  698.      } while(test) ;                    /* , ならば次の名前の処理     */
  699.  
  700.      if(sy == colon) {
  701.       insymbol() ;
  702.       if(sy == ident) {
  703.        mkset(&ws,types,-1) ;
  704.        lcp = searchid(ws)  ;            /* 型名を探す                 */
  705.        applied(lcp,top)    ;            /* 引用名チェーン             */
  706.        lsp = lcp->idtype   ;
  707.        lsize = ptrsize     ;            /*配列･ﾚｺｰﾄﾞ･変数ﾊﾟﾗ=ｱﾄﾞﾚｽｻｲｽﾞ*/
  708.        if(lsp)
  709.         if(lkind == actual)             /* 値パラメータ               */
  710.          if(lsp->form <= power) lsize = lsp->size ; /* ｽｶﾗ､範囲､ﾎﾟｲﾝﾀ､集合 */
  711.          else if(!lsp->assignflag) pcerr(121,"");
  712.                                         /* ファイルの要素型として許されない*/
  713.        if(kind == normal) {             /* ブロックと結合される引数   */  
  714.         lsize = align(parmptr,lsize) ;  /* パラメータリストの境界調整 */
  715.         updatelc(align(parmptr,lc) - lc);
  716.         updatelc(count*lsize)        ;  /* パラメータリスト領域を確保 */
  717.        }
  718.  
  719.        llc  = lc   ;
  720.        lcp3 = lcp2 ;                    /* 変数並びの最後の変数の名前アドレス*/
  721.        while(lcp2) {                    /* 各変数にエリアを割りつける */
  722.         lcp = lcp2;
  723.         lcp2->idtype = lsp ;            /* 型                         */
  724.         lcp2->linkno = (char)number++ ; /* 同形リンク番号             */
  725.         if(kind == normal) {            /* ブロックと結合される引数   */
  726.          llc -= lsize ;
  727.          lcp2->n.v.vaddr = llc ;        /* アドレス割りつけ           */
  728.         } 
  729.         lcp2 = lcp2->next ;
  730.        }
  731.        lcp->next = *fcp1 ;              /* 引数をチェーンしていく     */
  732.        *fcp1 = lcp3 ;                   /* 次回呼び出しのために       */
  733.  
  734.        insymbol() ;
  735.       }
  736.       else pcerr(2,"") ;                /* 名前がない                 */
  737.  
  738.       mkset(&ws,semicolon,rparent,-1);
  739.       orset(&ws,&fpfsys) ;
  740.       if(! inset(ws,sy)) {
  741.        pcerr(7,"") ;                    /* 引数の並びに誤りがある     */
  742.        skip(ws)    ;                    /* 読み飛ばし                 */
  743.       }
  744.      }
  745.      else pcerr(5,"") ;                 /* : がない                   */
  746. }
  747.